home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2005 October / PCWOCT05.iso / Software / FromTheMag / XAMPP 1.4.14 / xampp-win32-1.4.14-installer.exe / xampp / sendmail / sendmail.dpr < prev    next >
Encoding:
Text File  |  2005-04-30  |  10.8 KB  |  398 lines
  1. program sendmail;
  2.  
  3. {
  4.  
  5.   fake sendmail for windows
  6.  
  7.   Copyright (c) 2004-2005, Byron Jones, sendmail@glob.com.au
  8.   All rights reserved.
  9.  
  10.   requires indy 9 or higher
  11.  
  12.   version 12
  13.     - added cc and bcc support
  14.  
  15.   version 11
  16.     - added pop3 support (for pop before smtp authentication)
  17.  
  18.   version 10
  19.     - added support for specifying a different smtp port
  20.  
  21.   version 9
  22.     - added force_sender
  23.  
  24.   version 8
  25.     - *really* fixes broken smtp auth
  26.  
  27.   version 7
  28.     - fixes broken smtp auth
  29.  
  30.   version 6
  31.     - correctly quotes MAIL FROM and RCPT TO addresses in <>
  32.  
  33.   version 5
  34.     - now sends the message unchanged (rather than getting indy
  35.       to regenerate it)
  36.  
  37.   version 4
  38.     - added debug_logfile parameter
  39.     - improved error messages
  40.  
  41.   version 3
  42.     - smtp authentication support
  43.     - clearer error message when missing from or to address
  44.     - optional error logging
  45.     - adds date header if missing
  46.  
  47.   version 2
  48.     - reads default domain from registry (.ini setting overrides)
  49.  
  50.   version 1
  51.     - initial release
  52.  
  53.   Redistribution and use in source and binary forms, with or without
  54.   modification, are permitted provided that the following conditions
  55.   are met:
  56.  
  57.     * Redistributions of source code must retain the above copyright
  58.       notice, this list of conditions and the following disclaimer.
  59.  
  60.     * Redistributions in binary form must reproduce the above copyright
  61.       notice, this list of conditions and the following disclaimer in the
  62.       documentation and/or other materials provided with the distribution.
  63.  
  64.     * Neither the name of the glob nor the names of its contributors may
  65.       be used to endorse or promote products derived from this software
  66.       without specific prior written permission.
  67.  
  68.   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  69.   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  70.   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
  71.   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
  72.   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  73.   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
  74.   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  75.   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  76.   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  77.   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  78.   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  79.  
  80. }
  81.  
  82. {$APPTYPE CONSOLE}
  83.  
  84. uses
  85.   Windows, Classes, SysUtils, Registry, IniFiles, IDSmtp, IDPOP3, IdMessage, IdEmailAddress, IdLogFile, IdGlobal;
  86.  
  87. // ---------------------------------------------------------------------------
  88.  
  89. procedure writeToLog(const logFilename, logMessage: string);
  90. var
  91.   f: TextFile;
  92. begin
  93.   AssignFile(f, logFilename);
  94.   try
  95.  
  96.     if (not FileExists(logFilename)) then
  97.     begin
  98.       ForceDirectories(ExtractFilePath(logFilename));
  99.       Rewrite(f);
  100.     end
  101.     else
  102.       Append(f);
  103.  
  104.     writeln(f, '[' + DateTimeToStr(Now) + '] ' + stringReplace(logMessage, #13#10, ' ', [rfReplaceAll]));
  105.     closeFile(f);
  106.  
  107.   except
  108.     on e:Exception do
  109.       writeln('sendmail: error writing to ' + logFilename + ': ' + logMessage);
  110.   end;
  111. end;
  112.  
  113. // ---------------------------------------------------------------------------
  114.  
  115. function appendDomain(const address, domain: string): string;
  116. begin
  117.   Result := address;
  118.   if (Pos('@', address) <> 0) then
  119.     Exit;
  120.   Result := Result + '@' + domain;
  121. end;
  122.  
  123. // ---------------------------------------------------------------------------
  124.  
  125. var
  126.  
  127.   smtpServer    : string;
  128.   defaultDomain : string;
  129.   messageContent: string;
  130.   errorLogFile  : string;
  131.   debugLogFile  : string;
  132.   authUsername  : string;
  133.   authPassword  : string;
  134.   forceSender   : string;
  135.   pop3server    : string;
  136.   pop3username  : string;
  137.   pop3password  : string;
  138.  
  139.   registry: TRegistry;
  140.   iniFile : TIniFile;
  141.   idPop3  : TIdPop3;
  142.   idSmtp  : TIdSmtp;
  143.  
  144.   i     : integer;
  145.   s     : string;
  146.   found : boolean;
  147.   ss    : TStringStream;
  148.   msg   : TIdMessage;
  149.   debug : TIdLogFile;
  150.   sl    : TStringList;
  151.   header: boolean;
  152.  
  153. begin
  154.  
  155.   // check parameters to make sure "-t" was provided
  156.  
  157.   found := False;
  158.   for i := 1 to ParamCount do
  159.     if (ParamStr(i) = '-t') then
  160.     begin
  161.       found := True;
  162.       break;
  163.     end;
  164.  
  165.   if (not found) then
  166.   begin
  167.     writeln('sendmail requires -t parameter');
  168.     halt(1);
  169.   end;
  170.  
  171.   // read default domain from registry
  172.  
  173.   registry := TRegistry.Create;
  174.   try
  175.     registry.RootKey := HKEY_LOCAL_MACHINE;
  176.     if (registry.OpenKeyReadOnly('\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters')) then
  177.       defaultDomain := registry.ReadString('Domain');
  178.   finally
  179.     registry.Free;
  180.   end;
  181.  
  182.   // read ini
  183.  
  184.   iniFile := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
  185.   try
  186.  
  187.     smtpServer    := iniFile.ReadString('sendmail', 'smtp_server',    'mail.mydomain.com');
  188.     defaultDomain := iniFile.ReadString('sendmail', 'default_domain', defaultDomain);
  189.     errorLogFile  := iniFile.ReadString('sendmail', 'error_logfile',  '');
  190.     debugLogFile  := iniFile.ReadString('sendmail', 'debug_logfile',  '');
  191.     authUsername  := iniFile.ReadString('sendmail', 'auth_username',  '');
  192.     authPassword  := iniFile.ReadString('sendmail', 'auth_password',  '');
  193.     forceSender   := iniFile.ReadString('sendmail', 'force_sender',   '');
  194.     pop3server    := iniFile.ReadString('sendmail', 'pop3_server',    '');
  195.     pop3username  := iniFile.ReadString('sendmail', 'pop3_username',  '');
  196.     pop3password  := iniFile.ReadString('sendmail', 'pop3_password',  '');
  197.  
  198.     if (smtpServer = 'mail.mydomain.com') or (defaultDomain = 'mydomain.com') then
  199.     begin
  200.       writeln('you must configure the smtp_server and default_domain in ' + iniFile.fileName);
  201.       halt(1);
  202.     end;
  203.  
  204.   finally
  205.     iniFile.Free;
  206.   end;
  207.  
  208.   if (errorLogFile <> '') and (ExtractFilePath(errorLogFile) = '') then
  209.     errorLogFile := ExtractFilePath(ParamStr(0)) + errorLogFile;
  210.  
  211.   if (debugLogFile <> '') and (ExtractFilePath(debugLogFile) = '') then
  212.     debugLogFile := ExtractFilePath(ParamStr(0)) + debugLogFile;
  213.  
  214.   // read email from stdin
  215.  
  216.   messageContent := '';
  217.   while (not eof(Input)) do
  218.   begin
  219.     readln(Input, s);
  220.     messageContent := messageContent + s + #13#10;
  221.   end;
  222.  
  223.   if (debugLogFile <> '') then
  224.   begin
  225.     sl := TStringList.Create;
  226.     try
  227.       sl.Text := messageContent;
  228.       for i := 0 to sl.Count - 1 do
  229.         writeToLog(debugLogFile, sl[i]);
  230.     finally
  231.       sl.Free;
  232.     end;
  233.   end;
  234.  
  235.   // deliver message
  236.  
  237.   try
  238.  
  239.     // load message into stream (TidMessage expects message to end in ".")
  240.  
  241.     ss  := TStringStream.Create(messageContent + #13#10'.'#13#10);
  242.     msg := nil;
  243.  
  244.     try
  245.  
  246.       // load message
  247.  
  248.       msg := TIdMessage.Create(nil);
  249.       msg.LoadFromStream(ss);
  250.  
  251.       // check for from and to
  252.  
  253.       if (forceSender = '') and (Msg.From.Address = '') then
  254.         raise Exception.Create('email is missing sender''s address');
  255.       if (Msg.Recipients.Count = 0) and (Msg.CCList.Count = 0) and (Msg.BccList.Count = 0) then
  256.         raise Exception.Create('email is missing recipient''s address');
  257.  
  258.       if (debugLogFile <> '') then
  259.       begin
  260.         debug          := TIdLogFile.Create(nil);
  261.         debug.FileName := debugLogFile;
  262.         debug.Active   := True;
  263.       end
  264.       else
  265.         debug := nil;
  266.  
  267.       if ((pop3server <> '') and (pop3username <> '')) then
  268.       begin
  269.  
  270.         // pop3 before smtp auth
  271.  
  272.         idPop3 := TIdPOP3.Create(nil);
  273.         try
  274.           if (debug <> nil) then
  275.             idPop3.Intercept := debug;
  276.           idPop3.Host        := pop3server;
  277.           idPop3.Username    := pop3username;
  278.           idPop3.Password    := pop3password;
  279.           idPop3.Connect(10 * 1000);
  280.           idPop3.Disconnect;
  281.         finally
  282.           idPop3.free;
  283.         end;
  284.  
  285.       end;
  286.  
  287.       idSmtp := TIdSMTP.Create(nil);
  288.       try
  289.  
  290.         if (debug <> nil) then
  291.           idSmtp.Intercept := debug;
  292.  
  293.         // set host, port
  294.  
  295.         i := pos(':', smtpServer);
  296.         if (i = 0) then
  297.         begin
  298.           idSmtp.host := smtpServer;
  299.           idSmtp.port := 25;
  300.         end
  301.         else
  302.         begin
  303.           idSmtp.host := copy(smtpServer, 1, i - 1);
  304.           idSmtp.port := strToIntDef(copy(smtpServer, i + 1, length(smtpServer)), 25);
  305.         end;
  306.  
  307.         // connect to server
  308.  
  309.         idSmtp.Connect(10 * 1000);
  310.  
  311.         // authentication
  312.  
  313.         if (authUsername <> '') then
  314.         begin
  315.           idSmtp.AuthenticationType := atLogin;
  316.           idSmtp.Username := authUsername;
  317.           idSmtp.Password := authPassword;
  318.           idSmtp.Authenticate;
  319.         end;
  320.  
  321.         // sender and recipients
  322.  
  323.         if (forceSender = '') then
  324.           idSmtp.SendCmd('MAIL FROM: <' + appendDomain(Msg.From.Address, defaultDomain) + '>', [250])
  325.         else
  326.           idSmtp.SendCmd('MAIL FROM: <' + appendDomain(forceSender, defaultDomain) + '>', [250]);
  327.  
  328.         for i := 0 to msg.Recipients.Count - 1 do
  329.           idSmtp.SendCmd('RCPT TO: <' + appendDomain(Msg.Recipients[i].Address, defaultDomain) + '>', [250]);
  330.  
  331.         for i := 0 to msg.ccList.Count - 1 do
  332.           idSmtp.SendCmd('RCPT TO: <' + appendDomain(Msg.ccList[i].Address, defaultDomain) + '>', [250]);
  333.  
  334.         for i := 0 to msg.BccList.Count - 1 do
  335.           idSmtp.SendCmd('RCPT TO: <' + appendDomain(Msg.BccList[i].Address, defaultDomain) + '>', [250]);
  336.  
  337.         // start message content
  338.  
  339.         idSmtp.SendCmd('DATA', [354]);
  340.  
  341.         // add date header if missing
  342.  
  343.         if (Msg.Headers.Values['date'] = '') then
  344.           idSmtp.writeln('Date: ' + DateTimeToInternetStr(Now));
  345.  
  346.         // send message line by line
  347.  
  348.         sl := TStringList.Create;
  349.         try
  350.           sl.Text := messageContent;
  351.           header  := true;
  352.           for i := 0 to sl.Count - 1 do
  353.           begin
  354.             if (i = 0) and (sl[i] = '') then
  355.               continue;
  356.             if (sl[i] = '') then
  357.               header := false;
  358.             if (header) and (LowerCase(copy(sl[i], 1, 5)) = 'bcc: ') then
  359.               continue;
  360.             idSmtp.writeln(sl[i]);
  361.           end;
  362.         finally
  363.           sl.Free;
  364.         end;
  365.  
  366.         // done
  367.  
  368.         idSmtp.SendCmd('.', [250]);
  369.         idSmtp.SendCmd('QUIT');
  370.  
  371.       finally
  372.         idSmtp.Free;
  373.       end;
  374.  
  375.     finally
  376.       msg.Free;
  377.       ss.Free;
  378.     end;
  379.  
  380.   except
  381.     on e:Exception do
  382.     begin
  383.  
  384.       writeln('sendmail: error during delivery: ' + e.message);
  385.  
  386.       if (errorLogFile <> '') then
  387.         writeToLog(errorLogFile, e.Message);
  388.  
  389.       if (debugLogFile <> '') then
  390.         writeToLog(debugLogFile, e.Message);
  391.  
  392.       halt(1);
  393.     end;
  394.   end;
  395.  
  396. end.
  397.  
  398.